C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C       D S   -   Declaration Standardise a program (parse tree).
C
 
        SUBROUTINE DS(OPTSTR,CMTFD,DESC,NERRS,NWARNS)
        INTEGER OPTSTR(*),CMTFD,DESC,NERRS,NWARNS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSPEC/SPECP
        LOGICAL SPECP(132)
 
        SAVE /DSSPEC/
 
        INTEGER I,DUMMY(2)
 
        SAVE DUMMY
 
        INTEGER ZYROOT,ZYDOWN,ZYNEXT
        EXTERNAL ZYROOT,ZYDOWN,ZYNEXT,ZTOKWR,ZYGSSI,ZYGDSD,ERROR,ZYCSDT
 
        DATA DUMMY(1)/129/
 
        PUROOT=ZYDOWN(ZYROOT())
        PUNUM=0
        SNUM=1
        IODCMT=CMTFD
        TKDESC=DESC
        NERROR=0
        NWARN=0
        CALL DSOPT(OPTSTR)
 
C Change data-types to canonical forms if necessary
        IF (DTFORM.NE.0) CALL ZYCSDT(DTFORM,.TRUE.)
 
C Initialise common block DSSPEC
        DO 50 I=1,132
            SPECP(I)=.FALSE.
 50     CONTINUE
        SPECP(30)=.TRUE.
        SPECP(8)=.TRUE.
        SPECP(16)=.TRUE.
        SPECP(7)=.TRUE.
        SPECP(19)=.TRUE.
        SPECP(35)=.TRUE.
        SPECP(20)=.TRUE.
        SPECP(26)=.TRUE.
        SPECP(37)=.TRUE.
        SPECP(38)=.TRUE.
        SPECP(24)=.TRUE.
        SPECP(39)=.TRUE.
        SPECP(41)=.TRUE.
        SPECP(121)=.TRUE.
        SPECP(32)=.TRUE.
        SPECP(78)=.TRUE.
        SPECP(18)=.TRUE.
        SPECP(127)=.TRUE.
        SPECP(128)=.TRUE.
        SPECP(129)=.TRUE.
        SPECP(130)=.TRUE.
 
C Preprocess whole file to set "include" status flags (if any)
        IF (INCLPR .AND. PMODE.EQ.2) THEN
 100        PUNUM=PUNUM+1
            CALL PREPRO
            PUROOT=ZYNEXT(PUROOT)
            IF (PUROOT.GT.0) GOTO 100
            PUROOT=ZYDOWN(ZYROOT())
            PUNUM=0
            SNUM=1
        END IF
 
 200    DO 300 I=1,22
            DUMPED(I)=.FALSE.
 300    CONTINUE
        PUNUM=PUNUM+1
        IF (ICTWCB) THEN
            DUMPED(6)=.TRUE.
            DUMPED(7)=.TRUE.
        END IF
        CALL ZYGSSI(SYMIDX,NSYMS,PUNUM)
        CALL ZYGDSD(SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS,NSYMS)
        CALL SRTIDX
        SECNUM=0
        IF (PMODE.EQ.2) THEN
            CALL PROPU1
        ELSE IF (PMODE.EQ.1) THEN
            CALL PROPU2
        ELSE
            CALL ERROR('DS Internal Error: incorrect value for PMODE')
        END IF
        PUROOT=ZYNEXT(PUROOT)
        IF (PUROOT.GT.0) GOTO 200
        CALL ZTOKWR(TZEOF,0,DUMMY,TKDESC)
 
        NERRS=NERROR
        NWARNS=NWARN
 
        END
C ----------------------------------------------------------------------
C
C       D S O P T   -   This routine decodes an ISTDS option string.
C
 
        SUBROUTINE DSOPT(OPTSTR)
 
        INTEGER OPTSTR(*)
 
        INTEGER GETWRD,ZKWLUK,ZSCTOI,ZSPLIT
        EXTERNAL GETWRD,ZCHOUT,PUTLIN,ZMESS,ZKWLUK,ZSCTOI,ZSPLIT,SCOPY
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
 
        INTEGER OPTTBL(123),STRING(134),POINT,I,LHS(134),
     +          RHS(134),OPTION,YNCTBL(16),YNLTBL(12),
     +          MODTBL(45),RHSPTR,CAFTBL(47)
 
        SAVE OPTTBL,YNCTBL,YNLTBL,MODTBL,CAFTBL
 
        DATA OPTTBL/13,
     +      97,114,100,105,99,98,129,
     +      99,104,108,98,114,107,129,
     +      100,97,116,97,116,121,112,101,95,102,
     +111,114,109,129,
     +      101,120,101,104,100,114,129,
     +      103,101,110,105,110,116,129,
     +      105,99,116,119,99,98,129,
     +      105,110,99,108,117,100,101,95,112,114,
     +111,99,101,115,115,105,110,103,129,
     +      109,111,100,101,129,
     +      110,111,110,101,129,
     +      110,111,116,114,97,105,108,101,114,115,129,
     +      111,108,100,102,109,116,129,
     +      111,114,100,101,114,129,
     +      114,101,109,111,118,101,95,117,110,
     +117,115,101,100,95,110,97,109,101,115,129/
 
        DATA YNCTBL/3,
     +      99,111,110,118,101,114,116,129,
     +      110,111,129,
     +      121,101,115,129/
 
        DATA YNLTBL/3,
     +      108,111,103,129,
     +      110,111,129,
     +      121,101,115,129/
 
        DATA MODTBL/2,
     +      100,101,99,108,97,114,101,95,105,109,
     +112,108,105,99,105,116,95,110,97,109,101,115,129,
     +      114,101,98,117,105,108,100,95,100,101,
     +99,108,97,114,97,116,105,118,101,115,129/
 
        DATA CAFTBL/3,
     +      107,101,121,119,111,114,100,115,129,
     +      108,101,110,103,116,104,95,115,112,101,99,
     +105,102,105,101,114,115,129,
     +      110,111,116,95,100,111,117,98,108,101,
     +95,99,111,109,112,108,101,120,129/
 
        POINT=1
 
 100    IF (GETWRD(OPTSTR,POINT,STRING).EQ.0) RETURN
        IF (ZSPLIT(STRING,LHS,RHS).NE.-2) THEN
            CALL SCOPY(STRING,1,LHS,1)
            RHS(1)=129
        END IF
        OPTION=ZKWLUK(LHS,OPTTBL)
        IF (OPTION.LE.0) THEN
            IF (OPTION.EQ.0) CALL ZCHOUT('Warning: Ambiguous',2)
            IF (OPTION.EQ.-1)  CALL ZCHOUT('Warning: Unknown',2)
            CALL ZCHOUT(' option "',2)
            CALL PUTLIN(LHS,2)
            CALL ZMESS('" ignored',2)
            NWARN=NWARN+1
        ELSE IF (OPTION.EQ.1) THEN
            IF (RHS(1).NE.129)
     +          CALL DSWARN('Superfluous argument to the ARDICB option')
            ARDICB=.TRUE.
        ELSE IF (OPTION.EQ.2) THEN
            IF (RHS(1).NE.129)
     +          CALL DSWARN('Superfluous argument to the CHLBRK option')
            CHLBRK=.TRUE.
        ELSE IF (OPTION.EQ.3) THEN
            OPTION=ZKWLUK(RHS,CAFTBL)
            IF (OPTION.LT.0) THEN
                CALL DSWARN('Unknown value for DATATYPE_FORM option')
            ELSE IF (OPTION.EQ.0) THEN
                CALL DSWARN('Ambiguous value for DATATYPE_FORM option')
            ELSE
                DTFORM=OPTION
            END IF
        ELSE IF (OPTION.EQ.4) THEN
            IF (RHS(1).NE.129)
     +          CALL DSWARN('Superfluous argument to the EXEHDR option')
            EXEHDR=.TRUE.
        ELSE IF (OPTION.EQ.5) THEN
            IF (RHS(1).NE.129)
     +          CALL DSWARN('Superfluous argument to the GENINT option')
            CALL DSWARN('The GENINT option isn''t implemented')
            GENINT=.TRUE.
        ELSE IF (OPTION.EQ.6) THEN
            IF (RHS(1).NE.129)
     +          CALL DSWARN('Superfluous argument to the ICTWCB option')
            ICTWCB=.TRUE.
        ELSE IF (OPTION.EQ.7) THEN
            IF (RHS(1).NE.129)
     +          CALL DSWARN(
     +'Superfluous argument to the INCLUDE_PROCESSING option')
            INCLPR=.TRUE.
        ELSE IF (OPTION.EQ.8) THEN
            OPTION=ZKWLUK(RHS,MODTBL)
            IF (OPTION.LT.0) THEN
                CALL DSWARN('Unknown value for MODE option')
            ELSE IF (OPTION.EQ.0) THEN
                CALL DSWARN('Ambiguous value for MODE option')
            ELSE
                PMODE=OPTION
            END IF
        ELSE IF (OPTION.EQ.10) THEN
            IF (RHS(1).NE.129) CALL DSWARN(
     +          'Superfluous argument to the NOTRAILERS option')
            NOTRAI=.TRUE.
        ELSE IF (OPTION.EQ.11) THEN
            IF (RHS(1).NE.129) THEN
                OPTION=ZKWLUK(RHS,YNCTBL)
                IF (OPTION.EQ.1) THEN
                    OLDFMT=.TRUE.
                    CNVOLD=.TRUE.
                ELSE IF (OPTION.EQ.2) THEN
                    OLDFMT=.FALSE.
                    CNVOLD=.FALSE.
                ELSE IF (OPTION.EQ.3) THEN
                    OLDFMT=.TRUE.
                    CNVOLD=.FALSE.
                ELSE
                    CALL DSWARN('Invalid argument to the OLDFMT option')
                END IF
            ELSE
C If nothing, default is to convert
                OLDFMT=.TRUE.
                CNVOLD=.TRUE.
            END IF
        ELSE IF (OPTION.EQ.12) THEN
            RHSPTR=1
            DO 200 I=1,7
                IF (RHS(RHSPTR).EQ.129 .AND. I.EQ.7)
     +              CALL DSWARN('Insufficient values for ORDER option')
                DORDER(ZSCTOI(RHS,RHSPTR))=I
                IF (RHS(RHSPTR).NE.129) RHSPTR=RHSPTR+1
 200        CONTINUE
        ELSE IF (OPTION.EQ.13) THEN
            OPTION=ZKWLUK(RHS,YNLTBL)
            IF (OPTION.LE.0) THEN
                CALL DSWARN('Invalid value for REMOVE option')
            ELSE
                VMODE=OPTION
            END IF
        END IF
        GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       P R E P R O   -   Preprocess program-unit checking for includes.
C
 
        SUBROUTINE PREPRO
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/COMMNT/CMTTXT
        INTEGER CMTTXT(1310)
 
        SAVE /COMMNT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSPEC/SPECP
        LOGICAL SPECP(132)
 
        SAVE /DSSPEC/
 
        INTEGER SPTR,PTR,SYMBOL(8),NTYPE,BLANKC(8),
     +          BIND,ID(3),TEXT(134),TXTPTR,VPTR,INCLVL
        LOGICAL ISSED
 
        INTEGER SEC
 
        INTEGER ZYNTYP,ZYDOWN,ZYNEXT,ZYPREV,ZYGTCM,ZYGNCM,ZSEDID,ZYFSYM
        EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZYPREV,ZYGTCM,ZYGNCM,ZSEDID,
     +           ZYFSYM,ZYSABT,ZYCHNT
 
        DATA BLANKC/36,67,79,77,77,79,78,129/
 
        INCLVL=0
        STMTNO=1
 
C =============================PART ONE [OPTIONAL]: P.U. HEADER
 
        IF (ZYNTYP(PUROOT).NE.2 .OR.
     +      ZYNTYP(ZYDOWN(PUROOT)).EQ.7) THEN
C There is a program header - skip it
            SNUM=SNUM+1
            SPTR=ZYNEXT(ZYDOWN(PUROOT))
        ELSE
            SPTR=ZYDOWN(PUROOT)
        END IF
 
C =============================PART TWO: INCLUDE SPECIFICATIONS
 
C Procedure: Examine comments before each statement until we get to
C            first executable
 
 300    IF (ZYGTCM(IODCMT,SNUM,CMTTXT).EQ.-2) THEN
 400        ISSED=CMTTXT(1).EQ.42
            IF (ISSED) ISSED=ZSEDID(CMTTXT,BIND,ID,TEXT).EQ.-2
            IF (ISSED) THEN
                IF (ID(1).EQ.105 .AND. ID(2).EQ.110) THEN
                    TXTPTR=1
                    CALL SKIPBL(TEXT,TXTPTR)
                    IF (TEXT(1).EQ.98 .OR. TEXT(1).EQ.66) THEN
                        INCLVL=INCLVL+1
                    ELSE IF (TEXT(1).EQ.101 .OR. TEXT(1).EQ.69) THEN
                        IF (INCLVL.EQ.0)
     +                     CALL DSERR('Unexpected "end of include" SED')
                        INCLVL=MAX(0,INCLVL-1)
                    ELSE
                        CALL DSERR('Unrecognised "include" SED')
                    END IF
                END IF
            END IF
            IF (ZYGNCM(IODCMT,CMTTXT).EQ.-2) GO TO 400
        END IF
 
C End of comments for that statement -- see what to do
 
        NTYPE=ZYNTYP(SPTR)
 
        IF (INCLVL.NE.0) THEN
C
C INCLUDE checking:
C   Mark things as "in_include" if:
C       (A) COMMON blocks - the COMMON defn is in the INCLUDE
C       (B) COMMON variables - the COMMON defn is in the INCLUDE
C       (C) Typed variables - the type declaration is in the INCLUDE
C           [This may overlap with (B)]
C       (D) Implicit local arrays - the DIMENSION statement is in the INCLUDE
C       (E) Typed parameters - the type stmt or parameter stmt in the incl
C       (F) Untyped params - the PARAMETER stmt is in it
C       (G) Statement functions - the defn/type is in the include.
C
C   NOT DONE:
C       (1) Implicit local vars initialised by DATA in an include
C       (2) Implicit local vars defined by an EQUIVALENCE in an include
C       (3) Implicit local vars appearing only in a SAVE in an include
C
C   HOWEVER:
C       The DATA/EQUIVALENCE/SAVE statements will not be output by ISTDS
C       at all...
C
            IF (NTYPE.EQ.30 .OR. NTYPE.EQ.20) THEN
                PTR=ZYDOWN(SPTR)
                IF (NTYPE.EQ.30) PTR=ZYNEXT(PTR)
 500            IF (ZYNTYP(PTR).EQ.108) THEN
                    CALL ZYSABT(-ZYDOWN(PTR),6,2097152)
                ELSE
C (Must be an array declarator)
                    CALL ZYSABT(-ZYDOWN(ZYDOWN(PTR)),6,2097152)
                END IF
                PTR=ZYNEXT(PTR)
                IF (PTR.NE.0) GOTO 500
            ELSE IF (NTYPE.EQ.26) THEN
                CALL ZYCHNT(SPTR,129)
                PTR=ZYDOWN(SPTR)
 600            IF (ZYNTYP(PTR).EQ.28) THEN
                    CALL ZYSABT(-ZYDOWN(ZYDOWN(PTR)),6,2097152)
                    VPTR=ZYDOWN(ZYNEXT(ZYDOWN(PTR)))
                ELSE
                    CALL ZYSABT(ZYFSYM(BLANKC,PUNUM,SYMBOL),
     +                          6,2097152)
                    VPTR=ZYDOWN(ZYDOWN(PTR))
                END IF
 700            IF (ZYNTYP(VPTR).EQ.108) THEN
                    CALL ZYSABT(-ZYDOWN(VPTR),6,2097152)
                ELSE
C (Must be an array declarator)
                    CALL ZYSABT(-ZYDOWN(ZYDOWN(VPTR)),6,2097152)
                END IF
                VPTR=ZYNEXT(VPTR)
                IF (VPTR.NE.0) GOTO 700
                PTR=ZYNEXT(PTR)
                IF (PTR.NE.0) GOTO 600
            ELSE IF (NTYPE.EQ.35) THEN
                PTR=ZYDOWN(SPTR)
 800            CALL ZYSABT(-ZYDOWN(ZYDOWN(PTR)),6,2097152)
                PTR=ZYNEXT(PTR)
                IF (PTR.NE.0) GOTO 800
            ELSE IF (NTYPE.EQ.24) THEN
                CALL DSWARN('INCLUDEd EQUIVALENCE - Not fully checked')
                CALL ZYCHNT(SPTR,127)
            ELSE IF (NTYPE.EQ.41) THEN
                CALL DSWARN('INCLUDEd DATA - Not fully checked')
                CALL ZYCHNT(SPTR,128)
            ELSE IF (NTYPE.EQ.39) THEN
                CALL DSWARN('INCLUDEd SAVE - Not fully checked')
                CALL ZYCHNT(SPTR,130)
            END IF
        END IF
 
C Loop through all the specification statements
 
        IF (SPECP(NTYPE)) THEN
            SPTR=ZYNEXT(SPTR)
            SNUM=SNUM+1
            STMTNO=STMTNO+1
            GOTO 300
        END IF
 
        IF (INCLVL.GT.0)
     +      CALL DSWARN('INCLUDE''d file has 6 statements')
 
C =============================PART FOUR: Executable Statements
C (This just keeps SNUM correct for comment fetching)
 
 900    SPTR=ZYNEXT(SPTR)
        SNUM=SNUM+1
        IF (SPTR.NE.0) GOTO 900
 
        END
C ----------------------------------------------------------------------
C
C       P R O P U 1   -   Process Program-unit using mode=rebuild
C
 
        SUBROUTINE PROPU1
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/COMMNT/CMTTXT
        INTEGER CMTTXT(1310)
 
        SAVE /COMMNT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSPEC/SPECP
        LOGICAL SPECP(132)
 
        SAVE /DSSPEC/
 
        LOGICAL T
        PARAMETER (T=.TRUE.)
 
        INTEGER NXTSEC,SPTR,PTR,SYMBOL(8),NTYPE,BIND,ID(3),
     +          TEXT(134),TXTPTR
        LOGICAL MOVFMT,RAW
 
        INTEGER SEC
        LOGICAL EXISTS
 
        INTEGER ZYNTYP,ZYDOWN,ZYNEXT,ZYPREV,ZYGTCM,ZYGNCM,LENGTH
        EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZYGTSY,YDTYPE,ZYPREV,ZYDELT,YLEAF,
     +           YSTMT,ZTOKWR,ZYGTCM,ZYGNCM,LENGTH
 
        MOVFMT=.FALSE.
        RAW=.TRUE.
        STMTNO=1
C First remove unused names if required of us
        IF (VMODE.NE.2)  CALL REMUNU(VMODE.EQ.1)
 
C =============================PART ONE: [OPTIONAL] PROG UNIT HEADER
 
        IF (ZYNTYP(PUROOT).NE.2 .OR.
     +      ZYNTYP(ZYDOWN(PUROOT)).EQ.7) THEN
C There is a program header - output it with all its comments
            IF (ZYGTCM(IODCMT,SNUM,CMTTXT).EQ.-2) THEN
 100            CALL ZTOKWR(TCMMNT,LENGTH(CMTTXT),CMTTXT,TKDESC)
                IF (ZYGNCM(IODCMT,CMTTXT).EQ.-2) GO TO 100
            END IF
C Un-implicit the function header
            IF (ZYNTYP(PUROOT).EQ.3) THEN
                PTR=ZYDOWN(ZYDOWN(PUROOT))
                IF (ZYNTYP(PTR).EQ.115) THEN
                    CALL YLEAF(PTR,TKDESC)
                    PTR=ZYNEXT(PTR)
                    CALL ZYDELT(ZYPREV(PTR))
                END IF
                IF (ZYNTYP(PTR).EQ.108) THEN
                    CALL ZYGTSY(-ZYDOWN(PTR),SYMBOL)
                    CALL YDTYPE(SYMBOL(4),SYMBOL(5),
     +                          TKDESC)
                END IF
            END IF
C Output the program header
            CALL YSTMT(ZYDOWN(PUROOT),TKDESC)
            SNUM=SNUM+1
            STMTNO=STMTNO+1
            SPTR=ZYNEXT(ZYDOWN(PUROOT))
        ELSE
            SPTR=ZYDOWN(PUROOT)
        END IF
 
C =============================PART TWO: DECLARATIVE SECTIONS
 
C Procedure: Output comments before each statement until we get to
C            first executable or some other nasty type ...
 
 300    IF (ZYGTCM(IODCMT,SNUM,CMTTXT).EQ.-2) THEN
 
 400        NXTSEC=SEC()
            IF (NXTSEC.EQ.-1) THEN
                IF (SECNUM.EQ.0) THEN
                    CALL DSWARN('Unexpected End Of Section Marker')
                ELSE
                    CALL PTDEC(SECNUM)
                    SECNUM=-1
                END IF
            ELSE IF (NXTSEC.GT.0) THEN
                IF (SECNUM.EQ.19) THEN
                    CALL DSWARN('Unexpected section header removed')
                    IF (.NOT.RAW) THEN
                        CALL DSERR('Input sections in invalid order')
                    ELSE IF (NXTSEC.EQ.19) THEN
                        CALL DSWARN('Comments may be misplaced')
                    ELSE
                        CALL DSERR('Sections may be out of order')
                    END IF
                    NXTSEC=-2
                ELSE
                    RAW=.FALSE.
                    IF (SECNUM.GT.0 .AND. SECNUM.NE.19) THEN
                        CALL PTDEC(SECNUM)
                    END IF
                    SECNUM=NXTSEC
                END IF
            END IF
C If we just hit stmtfns or data or exes, output remaining ordinary stuf
            IF (NXTSEC.NE.0 .AND. (SECNUM.EQ.19 .OR.
     +          SECNUM.EQ.18 .OR. SECNUM.EQ.22))
     +          CALL DMPALL
C Output data/stmtfns if just hit exes
            IF (NXTSEC.NE.0 .AND.SECNUM.EQ.19) THEN
                IF (EXISTS(22).AND..NOT.DUMPED(22)) THEN
                    CALL PUTHDR(22)
                    CALL PTDEC(22)
                END IF
                IF (EXISTS(18) .AND..NOT.DUMPED(18)) THEN
                    CALL PUTHDR(18)
                    CALL PTDEC(18)
                END IF
            END IF
C Don't output (a) section trailers (already done by PTDEC)
C              (b) exehdr if not wanted
C              (c) misplaced (removed) section headers (same as (a))
            IF (NXTSEC.GE.0  .AND. (NXTSEC.NE.19 .OR. EXEHDR))
     +          CALL ZTOKWR(TCMMNT,LENGTH(CMTTXT),CMTTXT,TKDESC)
            IF (NXTSEC.EQ.-1) SECNUM=0
            IF (NXTSEC.EQ.-2) SECNUM=19
            IF (ZYGNCM(IODCMT,CMTTXT).EQ.-2) GO TO 400
        END IF
 
C End of comments for that statement type -- see what to do
 
        NTYPE=ZYNTYP(SPTR)
 
C Following is the paradigm for input without section headers:
C   1)  Comments before the last specification statement will come
C   immediately after the program-unit header;
C   2)  Comments between the last specification statement and the
C   first non-specification statement go into the section for that
C   statement (i.e. DATA/SFDEF/EXE).  If there is no EXE section (i.e.
C   the EXEHDR option is not used) comments for it will instead be
C   placed with the other declarative comments (otherwise the ISTDS
C   output may not be a fixed point - if the notrailers option is
C   used, or the comment may be misplaced later if the program is
C   changed such that another section is added).
C   2)  If the first non-specification statement is a DATA statement,
C   comments after the last specification statement and before the
C   last consecutive DATA statement will be in the DATA section;
C   3)  If the first non-specification statement is a statement function,
C   comments are treated similarly to case 2 above but in the
C   statement function definition section;
C   4)  If case 2 applies, comments after the last DATA statement will
C   either be placed in the SFDEF section (if existent) or in the EXE
C   section.
C   5) If there is no data or sfdef sections, comments after the last
C   specification statement go into the EXE section.
C
        IF (RAW .AND. SPECP(NTYPE)) THEN
            NTYPE=ZYNTYP(ZYNEXT(SPTR))
            IF (SECNUM.EQ.0) THEN
                IF (NTYPE.EQ.41) THEN
                    SECNUM=22
                    CALL DMPALL
                    CALL PUTHDR(22)
                ELSE IF (NTYPE.EQ.121) THEN
                    SECNUM=18
                    CALL DMPALL
                    CALL PUTHDR(18)
                ELSE IF (EXEHDR .AND. .NOT.SPECP(NTYPE)) THEN
C The DATA section may need to be forced out here...
                    IF (EXISTS(22)) THEN
                        CALL PUTHDR(22)
                        CALL PTDEC(22)
                    END IF
                    SECNUM=19
                    CALL DMPALL
                    CALL PUTHDR(19)
                END IF
            ELSE IF (SECNUM.EQ.22 .AND. NTYPE.EQ.121) THEN
                SECNUM=18
                CALL PTDEC(22)
                CALL PUTHDR(18)
            ELSE IF (SECNUM.EQ.22 .AND. NTYPE.NE.41 .OR.
     +          SECNUM.EQ.18 .AND. NTYPE.NE.121) THEN
                CALL PTDEC(SECNUM)
C Again, the DATA section may need to be forced out...
                IF (EXISTS(22).AND..NOT.DUMPED(22)) THEN
                    CALL PUTHDR(22)
                    CALL PTDEC(22)
                END IF
                SECNUM=19
                IF (EXEHDR) CALL PUTHDR(19)
            END IF
            NTYPE=ZYNTYP(SPTR)
        END IF
 
C The following loops through all the specification statements
 
        IF (SPECP(NTYPE)) THEN
            IF (NTYPE.EQ.78) MOVFMT=.TRUE.
            SPTR=ZYNEXT(SPTR)
            SNUM=SNUM+1
            STMTNO=STMTNO+1
            GOTO 300
        END IF
 
C We are now past the declarations bit
C first output anything we were partway through
 
        IF (SECNUM.NE.0 .AND. SECNUM.NE.19) THEN
            CALL PTDEC(SECNUM)
            SECNUM=0
        END IF
 
C Then check for anything left undone (unless we are within a section)
 
        IF (SECNUM.EQ.0) CALL DMPALL
 
C =============================PART THREE: Special Sections (SFDEF/DATA)
C
C (These are done in part two if the headers are already there).
 
C Check for DATA statements
 
        IF (EXISTS(22) .AND..NOT.DUMPED(22)) THEN
            CALL PUTHDR(22)
            CALL PTDEC(22)
        END IF
 
C Ditto Statement Function Definitions
 
        IF (EXISTS(18) .AND..NOT.DUMPED(18)) THEN
            CALL PUTHDR(18)
            CALL PTDEC(18)
        END IF
 
C =============================PART FOUR: Executable Statements
 
C Check to see if we need to put in an EXEHDR
        IF (EXEHDR .AND. SECNUM.NE.19 .AND. NTYPE.NE.6)
     +      CALL PUTHDR(19)
 
        PTR=SPTR
 
 500    NTYPE=ZYNTYP(SPTR)
        IF (NTYPE.NE.41 .AND. NTYPE.NE.6 .AND.
     +      NTYPE.NE.128) CALL YSTMT(SPTR,TKDESC)
        SPTR=ZYNEXT(SPTR)
        SNUM=SNUM+1
        STMTNO=STMTNO+1
        IF (SPTR.NE.0) THEN
            IF (ZYGTCM(IODCMT,SNUM,CMTTXT).EQ.-2) THEN
 600            CALL ZTOKWR(TCMMNT,LENGTH(CMTTXT),CMTTXT,TKDESC)
                IF (ZYGNCM(IODCMT,CMTTXT).EQ.-2) GO TO 600
            END IF
            GOTO 500
        END IF
 
C Format statements are moved to the end
        IF (MOVFMT) THEN
            SPTR=ZYDOWN(PUROOT)
 700        IF (ZYNTYP(SPTR).EQ.78) CALL YSTMT(SPTR,TKDESC)
            SPTR=ZYNEXT(SPTR)
            IF (SPTR.NE.PTR) GOTO 700
        END IF
 
C Okay, now output the END statement
        CALL YSTMT(ZYPREV(ZYDOWN(PUROOT)),TKDESC)
 
        END
C ----------------------------------------------------------------------
C
C       P R O P U 2   -   Process program-unit using mode=declare
C
 
        SUBROUTINE PROPU2
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/COMMNT/CMTTXT
        INTEGER CMTTXT(1310)
 
        SAVE /COMMNT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER NTYPE,NXTSEC,SPTR
        LOGICAL INDECS
 
        INTEGER SEC
        LOGICAL EXISTS
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP,ZYGTCM,ZYGNCM,LENGTH
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,ZYGTCM,ZYGNCM,LENGTH,YSTMT,
     +           ZTOKWR
 
        SPTR=ZYDOWN(PUROOT)
        INDECS=.TRUE.
 100    IF (ZYGTCM(IODCMT,SNUM,CMTTXT).EQ.-2) THEN
 200        CALL ZTOKWR(TCMMNT,LENGTH(CMTTXT),CMTTXT,TKDESC)
            NXTSEC=SEC()
            IF (NXTSEC.EQ.21) THEN
                CALL OUTDEC(21)
            ELSE IF (NXTSEC.GT.0) THEN
                SECNUM=NXTSEC
            END IF
            IF (ZYGNCM(IODCMT,CMTTXT).EQ.-2) GO TO 200
        END IF
        IF (INDECS) THEN
            NTYPE=ZYNTYP(SPTR)
            IF (NTYPE.NE.30 .AND. NTYPE.NE.8 .AND.
     +          NTYPE.NE.16 .AND. NTYPE.NE.7 .AND.
     +          NTYPE.NE.19 .AND. NTYPE.NE.35 .AND.
     +          NTYPE.NE.20 .AND. NTYPE.NE.26 .AND.
     +          NTYPE.NE.37 .AND. NTYPE.NE.38 .AND.
     +          NTYPE.NE.24 .AND. NTYPE.NE.39 .AND.
     +          NTYPE.NE.32) THEN
                INDECS=.FALSE.
                IF (EXISTS(21) .AND. .NOT. DUMPED(21))
     +          THEN
                    CALL PUTHDR(21)
                    CALL OUTDEC(21)
                    CALL PUTEOS
                END IF
                IF (EXEHDR .AND. SECNUM.NE.19)
     +              CALL PUTHDR(19)
            END IF
            IF (NTYPE.NE.32) CALL YSTMT(SPTR,TKDESC)
        ELSE
            CALL YSTMT(SPTR,TKDESC)
        END IF
        SNUM=SNUM+1
        STMTNO=STMTNO+1
        SPTR=ZYNEXT(SPTR)
        IF (SPTR.NE.0) GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       D M P A L L   -   Dump all declarative sections not yet done
C
 
        SUBROUTINE DMPALL
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
 
        INTEGER I
 
        LOGICAL EXISTS
 
        DO 100 I=1,17
            IF (.NOT.DUMPED(I)) THEN
                IF (EXISTS(I)) THEN
                    CALL PUTHDR(I)
                    CALL OUTDEC(I)
                    IF (.NOT. NOTRAI) CALL PUTEOS
                END IF
            END IF
 100    CONTINUE
 
        END
C ----------------------------------------------------------------------
C
C       P T D E C   -   Put a declarative section into the output
C
 
        SUBROUTINE PTDEC(N)
        INTEGER N
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
 
        LOGICAL EXISTS
 
        EXTERNAL ZPTINT,ZCHOUT
 
        IF (EXISTS(N)) THEN
            CALL OUTDEC(N)
        ELSE
            CALL ZCHOUT('Warning: Empty declarative section requested'//
     +                  ' (section ',2)
            CALL ZPTINT(N,1,2)
            CALL ZCHOUT(')',2)
            CALL DSNAME
        END IF
        IF (.NOT.NOTRAI) CALL PUTEOS
 
        END
C ----------------------------------------------------------------------
C
C       S R T I D X   -   Sort symbol index
C
C       Sort key: Symbol type (then) Data type (then) Current position
C                 (Current position is as sorted by name)
C
 
        SUBROUTINE SRTIDX
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
 
        INTEGER I,J,K,T1,T2,T3,T4,T5
 
        LOGICAL LESS
 
C We will use a form of straight insertion
        DO 300 I=2,NSYMS
            J=I-1
C while J>1 and a(i).lt.a(j) do j=j-1
 100        IF (J.GE.1 .AND. LESS(I,J)) THEN
                J=J-1
                GOTO 100
            END IF
            J=J+1
            T1=STYPE(I)
            T2=SDTYPE(I)
            T3=SCHLEN(I)
            T4=SYMIDX(I)
            T5=SBITS(I)
            DO 200 K=I,J+1,-1
                STYPE(K)=STYPE(K-1)
                SDTYPE(K)=SDTYPE(K-1)
                SCHLEN(K)=SCHLEN(K-1)
                SBITS(K)=SBITS(K-1)
 200            SYMIDX(K)=SYMIDX(K-1)
            STYPE(J)=T1
            SDTYPE(J)=T2
            SCHLEN(J)=T3
            SYMIDX(J)=T4
            SBITS(J)=T5
 300    CONTINUE
        END
C ----------------------------------------------------------------------
C
C       L E S S   -   Return .TRUE. iff symbol[i].lt.symbol[j]
C
 
        LOGICAL FUNCTION LESS(I,J)
        INTEGER I,J,IDORD,JDORD
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
 
        IF (J.LT.1) THEN
            LESS=.FALSE.
            RETURN
        ENDIF
        IF (SDTYPE(I).EQ.4 .AND. SCHLEN(I).EQ.16) THEN
            IDORD=DORDER(7)
        ELSE
            IDORD=DORDER(SDTYPE(I))
        ENDIF
        IF (SDTYPE(J).EQ.4 .AND. SCHLEN(J).EQ.16) THEN
            JDORD=DORDER(7)
        ELSE
            JDORD=DORDER(SDTYPE(J))
        ENDIF
        IF (STYPE(I).LT.STYPE(J)) THEN
            LESS=.TRUE.
        ELSE IF (STYPE(I).GT.STYPE(J)) THEN
            LESS=.FALSE.
        ELSE IF (STYPE(I).EQ.12) THEN
            LESS=.FALSE.
        ELSE IF (IDORD.LT.JDORD) THEN
            LESS=.TRUE.
        ELSE IF (IDORD.GT.JDORD) THEN
            LESS=.FALSE.
        ELSE IF (SDTYPE(I).EQ.6) THEN
            IF (SCHLEN(I).GE.0 .AND. SCHLEN(J).GE.0) THEN
                LESS=SCHLEN(I).LT.SCHLEN(J)
            ELSE
                LESS=SCHLEN(I).GT.SCHLEN(J)
            END IF
        ELSE IF (SCHLEN(I).EQ.SCHLEN(J)) THEN
            LESS=.FALSE.
        ELSE IF (SDTYPE(I).EQ.1 .OR.
     +           SDTYPE(I).EQ.3) THEN
            IF (SCHLEN(I).EQ.0) THEN
                LESS=.TRUE.
            ELSE IF (SCHLEN(J).EQ.0) THEN
                LESS=.FALSE.
            ELSE
                LESS=SCHLEN(I).GT.SCHLEN(J)
            END IF
        ELSE
            LESS=SCHLEN(I).GT.SCHLEN(J)
        END IF
 
        END
C ======================================================================
C
C       D S   V I R T U A L   M A C H I N E   L E V E L   O N E
C
C ======================================================================
C ----------------------------------------------------------------------
C
C       O U T D E C   -   Output a declarative section
C
 
        SUBROUTINE OUTDEC(N)
        INTEGER N
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        EXTERNAL ZCHOUT,ZPTINT,ERROR
 
        IF (DUMPED(N)) THEN
            CALL ZCHOUT('Warning: Request for duplicate section ',2)
            CALL ZPTINT(N,1,2)
            CALL DSNAME
            RETURN
        END IF
 
        IF (N.EQ.11 .OR. N.EQ.5) THEN
            CALL OUTLST(TEXTER,N)
        ELSE IF (N.EQ.12) THEN
            CALL OUTLST(TINTRI,N)
        ELSE IF (N.EQ.1) THEN
            CALL OUTPAR
        ELSE IF (N.EQ.13) THEN
            CALL OUTCMN
        ELSE IF (N.LE.15) THEN
            CALL OUTSD(N)
            IF (N.EQ.10 .OR. N.EQ.4) CALL OUTLST(TEXTER,N)
            IF (N.EQ.15) CALL OUTSPD(18)
        ELSE IF (N.EQ.16) THEN
            CALL OUTSPD(24)
        ELSE IF (N.EQ.17) THEN
            CALL OUTSAV
        ELSE IF (N.EQ.21) THEN
            CALL OUTUND
        ELSE IF (N.EQ.18) THEN
            CALL OUTSPD(121)
        ELSE IF (N.EQ.22) THEN
            CALL OUTSPC(41)
        ELSE
            CALL ERROR('Internal Error: Invalid call to OUTDEC')
        END IF
 
        DUMPED(N)=.TRUE.
 
        END
C ----------------------------------------------------------------------
C
C       R E M U N U   -   Remove unused names from our internal symbols
C
 
        SUBROUTINE REMUNU(LOG)
        LOGICAL LOG
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
 
        INTEGER I,J,TEXT(134),SYMBOL(8),SAVNUM
 
        INTEGER ZIAND
        EXTERNAL ZIAND,ZYGTSY,ZYGTST,ZCHOUT,PUTLIN
 
        SAVNUM=STMTNO
        STMTNO=0
        DO 200 I=NSYMS,1,-1
            IF ((STYPE(I).EQ.9 .OR. STYPE(I).EQ.8 .OR.
     +           STYPE(I).EQ.10 .OR. STYPE(I).EQ.11 .OR.
     +           STYPE(I).EQ.12 .OR. STYPE(I).EQ.1) .AND.
     +           ZIAND(SBITS(I),125936).EQ.0)
     +      THEN
                IF (LOG) THEN
                    CALL ZCHOUT('Warning: Removing unu'//'sed name "',
     +                          2)
                    CALL ZYGTSY(SYMIDX(I),SYMBOL)
                    CALL ZYGTST(SYMBOL(2),TEXT)
                    CALL PUTLIN(TEXT,2)
                    CALL ZCHOUT('" ',2)
                    CALL DSNAME
                END IF
                DO 100 J=I+1,NSYMS
                    STYPE(J-1)=STYPE(J)
                    SDTYPE(J-1)=SDTYPE(J)
                    SYMIDX(J-1)=SYMIDX(J)
                    SCHLEN(J-1)=SCHLEN(J)
                    SBITS(J-1)=SBITS(J)
 100            CONTINUE
                NSYMS=NSYMS-1
            END IF
 200    CONTINUE
        STMTNO=SAVNUM
 
        END
C ======================================================================
C
C       D S   V I R T U A L   M A C H I N E   L E V E L   Z E R O
C
C ======================================================================
C ----------------------------------------------------------------------
C
C       P U T E O S   -   Output an end-of-section marker
C
 
        SUBROUTINE PUTEOS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER EOSTXT(9)
 
        SAVE EOSTXT
 
        EXTERNAL ZTOKWR
 
        DATA EOSTXT/67,32,32,32,32,32,46,46,129/
 
        CALL ZTOKWR(TCMMNT,8,EOSTXT,TKDESC)
 
        END
C ----------------------------------------------------------------------
C
C       P U T H D R   -   Output a section header
C
 
        SUBROUTINE PUTHDR(N)
        INTEGER N
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSTEXT/ SHTEXT,OLDTXT
        INTEGER SHTEXT(43,0:22),OLDTXT(43,10:11)
 
        SAVE /DSTEXT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
 
        INTEGER LENGTH
        EXTERNAL LENGTH,ZTOKWR
 
        IF ((N.EQ.10 .OR. N.EQ.11) .AND.
     +      (OLDFMT .AND. .NOT. CNVOLD)) THEN
            CALL ZTOKWR(TCMMNT,LENGTH(OLDTXT(1,N)),OLDTXT(1,N),TKDESC)
        ELSE
            CALL ZTOKWR(TCMMNT,LENGTH(SHTEXT(1,N)),SHTEXT(1,N),TKDESC)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       S E C   -   Return section number or -1 for endsec or 0 o/w
C
 
        INTEGER FUNCTION SEC()
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSTEXT/ SHTEXT,OLDTXT
        INTEGER SHTEXT(43,0:22),OLDTXT(43,10:11)
 
        SAVE /DSTEXT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/COMMNT/CMTTXT
        INTEGER CMTTXT(1310)
 
        SAVE /COMMNT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
 
        INTEGER PNTR,I,S
        LOGICAL EQUAL
 
        INTEGER ZUPPER
        EXTERNAL SKIPBL,ZCHOUT,PUTLIN,ZUPPER,SCOPY
 
        SEC=0
        IF (CMTTXT(1).EQ.129) RETURN
        PNTR=2
        CALL SKIPBL(CMTTXT,PNTR)
        IF (CMTTXT(PNTR).NE.46) RETURN
        IF (CMTTXT(PNTR+1).NE.46) RETURN
        IF (CMTTXT(PNTR+2).EQ.129) THEN
            SEC=-1
            CALL SCOPY(SHTEXT(1,0),1,CMTTXT,1)
            RETURN
        END IF
        DO 200 S=1,22
            I=0
 100        I=I+1
            EQUAL=(ZUPPER(SHTEXT(9+I,S)).EQ.ZUPPER(CMTTXT(PNTR+2+I)))
            IF (EQUAL .AND. CMTTXT(PNTR+2+I).NE.129) GOTO 100
            IF (EQUAL) THEN
                CALL SCOPY(SHTEXT(1,S),1,CMTTXT,1)
                SEC=S
                RETURN
            END IF
 200    CONTINUE
        IF (OLDFMT) THEN
            DO 400 S=10,11
                I=0
 300            I=I+1
                EQUAL=(ZUPPER(OLDTXT(9+I,S)) .EQ.
     +                 ZUPPER(CMTTXT(PNTR+2+I)))
                IF (EQUAL .AND. CMTTXT(PNTR+2+I).NE.129) GOTO 300
                IF (EQUAL) THEN
                    IF (CNVOLD) THEN
                        CALL SCOPY(SHTEXT(1,S),1,CMTTXT,1)
                    ELSE
                        CALL SCOPY(OLDTXT(1,S),1,CMTTXT,1)
                    END IF
                    SEC=S
                    RETURN
                END IF
 400        CONTINUE
        END IF
        CALL ZCHOUT('Warning: Unknown section header - "',2)
        CALL PUTLIN(CMTTXT(PNTR),2)
        CALL ZCHOUT('" - ignored',2)
        CALL DSNAME
        SEC=0
 
        END
C ----------------------------------------------------------------------
C
C       E X I S T S   -   Say whether a section exists or not
C
 
        LOGICAL FUNCTION EXISTS(N)
        INTEGER N
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSPEC/SPECP
        LOGICAL SPECP(132)
 
        SAVE /DSSPEC/
 
        LOGICAL T
        PARAMETER (T=.TRUE.)
 
        INTEGER I,PTR,REQTYP,NTYPE
        LOGICAL CHKALL
 
        LOGICAL EXIUND
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,ERROR
 
        IF (N.LE.15) THEN
            I=0
 100        I=I+1
            IF (STYPE(I).LT.N .AND. I.LT.NSYMS) GOTO 100
            EXISTS=STYPE(I).EQ.N
            IF (N.NE.15 .OR..NOT.EXISTS) RETURN
C ENTRY section exists either if function (sdtype>0) or an entry stmt
C occurs in the declaratives
            IF (SDTYPE(I).GT.0) RETURN
        END IF
C
        CHKALL=.FALSE.
        IF (N.EQ.16) THEN
            REQTYP=24
        ELSE IF (N.EQ.17) THEN
            REQTYP=39
        ELSE IF (N.EQ.18) THEN
            REQTYP=121
        ELSE IF (N.EQ.22) THEN
            REQTYP=41
            CHKALL=.TRUE.
        ELSE IF (N.EQ.15) THEN
            REQTYP=18
        ELSE IF (N.EQ.21) THEN
            EXISTS=EXIUND()
            RETURN
        ELSE
            CALL ERROR('Internal Error: Invalid EXISTS call')
            EXISTS=.FALSE.
            RETURN
        END IF
        PTR=ZYDOWN(PUROOT)
        EXISTS=.FALSE.
 
        IF (CHKALL) THEN
 200        IF (ZYNTYP(PTR).EQ.REQTYP) THEN
                EXISTS=.TRUE.
            ELSE
                PTR=ZYNEXT(PTR)
                IF (PTR.NE.0) GOTO 200
            END IF
        ELSE
 300        NTYPE=ZYNTYP(PTR)
            IF (NTYPE.EQ.REQTYP) THEN
                EXISTS=.TRUE.
            ELSE IF (SPECP(NTYPE)) THEN
                PTR=ZYNEXT(PTR)
                IF (PTR.NE.0) GOTO 300
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       E X I U N D   -   Any undeclared (untyped) names?
C
 
        LOGICAL FUNCTION EXIUND()
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
 
        INTEGER I
 
        INTEGER ZIAND
        EXTERNAL ZIAND
 
        DO 100 I=1,NSYMS
            IF (SDTYPE(I).GT.0 .AND. STYPE(I).NE.12 .AND.
     +          ZIAND(SBITS(I),8).EQ.0) THEN
                EXIUND=.TRUE.
                RETURN
            END IF
 100    CONTINUE
        EXIUND=.FALSE.
 
        END
C ----------------------------------------------------------------------
C
C       O U T L S T   -   Output a list of symbol names preceded by a
C                         token (TEXTER or TINTRI)
C
 
        SUBROUTINE OUTLST(TOKEN,N)
        INTEGER TOKEN,N
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER I,DUMMY(2),SYMBOL(8),TEXT(134)
 
        INTEGER LENGTH
        EXTERNAL ZTOKWR,LENGTH,ZYGTSY,ZYGTST
 
        DATA DUMMY(1)/129/
 
        I=0
 
 100    I=I+1
        IF (I.LT.NSYMS .AND. STYPE(I).NE.N) GOTO 100
        IF (STYPE(I).NE.N .OR. I.GT.NSYMS) RETURN
        CALL ZTOKWR(TOKEN,0,DUMMY,TKDESC)
 
 200    CALL ZYGTSY(SYMIDX(I),SYMBOL)
        CALL ZYGTST(SYMBOL(2),TEXT)
        CALL ZTOKWR(TNAME,LENGTH(TEXT),TEXT,TKDESC)
        I=I+1
        IF (I.LE.NSYMS .AND. STYPE(I).EQ.N) THEN
            CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
            GOTO 200
        END IF
        CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
 
        END
C ----------------------------------------------------------------------
C
C       O U T S D   -   Output a simple (type) declaration
C
 
        SUBROUTINE OUTSD(N)
        INTEGER N
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        SAVE DUMMY
 
        INTEGER I,LTYPE,DUMMY(2),LCHLEN,TEXT(134),SYMBOL(8)
 
        INTEGER LENGTH,ZYNTYP
        EXTERNAL ZTOKWR,LENGTH,ZYNTYP,ZYGTSY,ZYGTST,YDTYPE,YCHLEN,YARDCL
 
        DATA DUMMY(1)/129/
 
        LTYPE=0
        LCHLEN=0
        I=0
 
 100    I=I+1
        IF (I.LT.NSYMS .AND. STYPE(I).NE.N) GOTO 100
 
        IF (STYPE(I).NE.N .OR. I.GT.NSYMS) RETURN
 
 200    IF (LTYPE.NE.SDTYPE(I) .OR.
     +      (LCHLEN.NE.SCHLEN(I) .AND. (CHLBRK.OR.LTYPE.NE.6)))
     +  THEN
            IF (SDTYPE(I).EQ.-1) RETURN
            IF (LTYPE.NE.0) CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
            IF (CHLBRK .OR. SDTYPE(I).NE.6) THEN
                CALL YDTYPE(SDTYPE(I),SCHLEN(I),TKDESC)
                LCHLEN=SCHLEN(I)
            ELSE
                CALL YDTYPE(SDTYPE(I),0,TKDESC)
                LCHLEN=0
            END IF
            LTYPE=SDTYPE(I)
        ELSE
            CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
        END IF
        CALL ZYGTSY(SYMIDX(I),SYMBOL)
        CALL ZYGTST(SYMBOL(2),TEXT)
        CALL ZTOKWR(TNAME,LENGTH(TEXT),TEXT,TKDESC)
        IF (SYMBOL(1).EQ.5 .AND.
     +      SYMBOL(7).NE.0 .AND.
     +      (N.NE.7 .OR. .NOT. ARDICB))
     +      CALL YARDCL(SYMBOL(7),TKDESC)
        IF (SCHLEN(I).NE.LCHLEN) CALL YCHLEN(SCHLEN(I),TKDESC)
        I=I+1
        IF (STYPE(I).EQ.N .AND. I.LE.NSYMS) GOTO 200
        CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
 
        END
C ----------------------------------------------------------------------
C
C       O U T S A V   -   Output a SAVE statement
C
 
        SUBROUTINE OUTSAV
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        SAVE DUMMY
 
        INTEGER SPTR,PTR,DUMMY(2)
        LOGICAL FIRST
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,ZTOKWR,ERROR,YLEAF
 
        DATA DUMMY(1)/129/
 
        SPTR=ZYDOWN(PUROOT)
        FIRST=.TRUE.
 
 100    IF (ZYNTYP(SPTR).EQ.39 .AND.
     +      ZYDOWN(SPTR).EQ.0) THEN
C Found a blank SAVE statement - so we don't need to make a list
C of everything mentioned in a SAVE
            CALL ZTOKWR(TSAVE,0,DUMMY,TKDESC)
            CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
            RETURN
        END IF
        SPTR=ZYNEXT(SPTR)
        IF (SPTR.NE.0) GOTO 100
 
        SPTR=ZYDOWN(PUROOT)
 
 200    IF (ZYNTYP(SPTR).EQ.39) THEN
            IF (FIRST) CALL ZTOKWR(TSAVE,0,DUMMY,TKDESC)
            PTR=ZYDOWN(SPTR)
            IF (PTR.NE.0) THEN
                IF (ZYNTYP(PTR).EQ.115) PTR=ZYNEXT(PTR)
            END IF
            IF (PTR.EQ.0) CALL ERROR('ISTDS(OUTSAV): Internal Error')
 300        IF (.NOT.FIRST) CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
            FIRST=.FALSE.
            CALL YLEAF(PTR,TKDESC)
            PTR=ZYNEXT(PTR)
            IF (PTR.NE.0) GOTO 300
        END IF
        SPTR=ZYNEXT(SPTR)
        IF (SPTR.NE.0) THEN
            IF (ZYNTYP(SPTR).NE.49) GOTO 200
        END IF
        IF (.NOT.FIRST) CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
 
        END
C ----------------------------------------------------------------------
C
C       O U T P A R   -   Output Parameter Statements
C
 
        SUBROUTINE OUTPAR
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        SAVE DUMMY
 
        INTEGER SYMBOL(8),LDTYPE,LCHLEN,PTR,PTR2,DUMMY(2),
     +          TEXT(134),SAVNUM
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP,LENGTH,ZIAND,ZYPREV
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,LENGTH,ZYGTSY,ZYGTST,ZTOKWR,
     +           YDTYPE,YSTMT,YCHLEN,ZIAND,ZYPREV,ZYDELT
 
        DATA DUMMY(1)/129/
 
        LDTYPE=0
        LCHLEN=0
        PTR=ZYDOWN(PUROOT)
        SAVNUM=STMTNO
        STMTNO=1
 
 100    IF (ZYNTYP(PTR).EQ.35) THEN
            PTR2=ZYDOWN(PTR)
 200        CALL ZYGTSY(-ZYDOWN(ZYDOWN(PTR2)),SYMBOL)
            CALL ZYGTST(SYMBOL(2),TEXT)
            IF (VMODE.NE.2 .AND.
     +          ZIAND(SYMBOL(6),125936).EQ.0) THEN
                IF (VMODE.EQ.1) THEN
                    CALL ZCHOUT('Warning: Removing unu'//'sed name "',
     +                          2)
                    CALL PUTLIN(TEXT,2)
                    CALL ZCHOUT('" ',2)
                    CALL DSNAME
                END IF
                IF (ZYNEXT(PTR2).EQ.0) THEN
                    CALL ZYDELT(PTR2)
                    PTR2=0
                ELSE
                    PTR2=ZYNEXT(PTR2)
                    CALL ZYDELT(ZYPREV(PTR2))
                END IF
            ELSE
                IF (SYMBOL(4).NE.LDTYPE) THEN
                    IF (LDTYPE.NE.0) CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
                    LDTYPE=SYMBOL(4)
                    LCHLEN=SYMBOL(5)
                    CALL YDTYPE(LDTYPE,LCHLEN,TKDESC)
                ELSE
                    CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
                END IF
                CALL ZTOKWR(TNAME,LENGTH(TEXT),TEXT,TKDESC)
                IF (SYMBOL(5).NE.LCHLEN)
     +              CALL YCHLEN(SYMBOL(5),TKDESC)
                PTR2=ZYNEXT(PTR2)
            END IF
            IF (PTR2.GT.0) GOTO 200
            IF (ZYDOWN(PTR).NE.0) THEN
                CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
                CALL YSTMT(PTR,TKDESC)
            END IF
            LDTYPE=0
            LCHLEN=0
        END IF
        PTR=ZYNEXT(PTR)
        STMTNO=STMTNO+1
        IF (PTR.GT.0) GOTO 100
        STMTNO=SAVNUM
 
        END
C ----------------------------------------------------------------------
C
C       O U T C M N   -   Output COMMON statements (one per block)
C
 
        SUBROUTINE OUTCMN
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        SAVE DUMMY
 
        INTEGER SYMBOL(8),TEXT(134),PTR,I,DUMMY(2),PTR2
        LOGICAL BLANK
 
        LOGICAL EXISTS
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP,LENGTH,ZYUP
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,LENGTH,ZYUP,ZTOKWR,ZYGTSY,ZYGTST,
     +           YARDCL,ZCHOUT,ZMESS,PUTLIN
 
        DATA DUMMY(1)/129/
 
        I=0
 100    I=I+1
        IF (STYPE(I).NE.13) GOTO 100
 
 200    CALL ZYGTSY(SYMIDX(I),SYMBOL)
        CALL ZYGTST(SYMBOL(2),TEXT)
        IF (SYMBOL(4).EQ.0) THEN
            NERROR=NERROR+1
            CALL ZCHOUT('Error: Common block /',2)
            CALL PUTLIN(TEXT,2)
            CALL ZMESS('/ is n'//'ot defined',2)
            I=I+1
            IF (I.LE.NSYMS) THEN
                IF (STYPE(I).EQ.13) GOTO 200
            END IF
            GOTO 700
        END IF
        CALL ZTOKWR(TCOMMO,0,DUMMY,TKDESC)
        BLANK=TEXT(1).EQ.36
        IF (.NOT.BLANK) THEN
            CALL ZTOKWR(TSLASH,0,DUMMY,TKDESC)
            CALL ZTOKWR(TNAME,LENGTH(TEXT),TEXT,TKDESC)
            CALL ZTOKWR(TSLASH,0,DUMMY,TKDESC)
        END IF
C Output initial part of this common block
        PTR=SYMBOL(4)
 300    PTR2=ZYDOWN(PTR)
        IF (.NOT.BLANK) PTR2=ZYNEXT(PTR2)
        PTR2=ZYDOWN(PTR2)
 400    IF (ZYNTYP(PTR2).EQ.108) THEN
            CALL ZYGTSY(-ZYDOWN(PTR2),SYMBOL)
        ELSE
            CALL ZYGTSY(-ZYDOWN(ZYDOWN(PTR2)),SYMBOL)
        END IF
        CALL ZYGTST(SYMBOL(2),TEXT)
        CALL ZTOKWR(TNAME,LENGTH(TEXT),TEXT,TKDESC)
        IF (ARDICB .AND. SYMBOL(7).GT.0)
     +      CALL YARDCL(SYMBOL(7),TKDESC)
        PTR2=ZYNEXT(PTR2)
        IF (PTR2.NE.0) THEN
            CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
            GOTO 400
        END IF
C Must search tree for further occurrences of this common block
C First search rest of this COMMON statement
        IF (ZYNEXT(PTR).EQ.0) THEN
            PTR=ZYNEXT(ZYUP(PTR))
C But not if there isn't any
            GOTO 600
        END IF
        PTR=ZYNEXT(PTR)
 500    IF ((BLANK .AND. ZYNTYP(PTR).EQ.27) .OR.
     +      (.NOT.BLANK .AND. -ZYDOWN(ZYDOWN(PTR)).EQ.SYMIDX(I))) THEN
            CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
            GOTO 300
        END IF
        IF (ZYNEXT(PTR).NE.0) THEN
            PTR=ZYNEXT(PTR)
            GOTO 500
        END IF
C End of a COMMON statement, get back up to statement level and continue
        PTR=ZYNEXT(ZYUP(PTR))
 600    IF (ZYNTYP(PTR).EQ.26) THEN
            PTR=ZYDOWN(PTR)
            GOTO 500
        END IF
        PTR=ZYNEXT(PTR)
        IF (PTR.NE.0) GOTO 600
C Looks like we finally finished this COMMON statement - End it off
        CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
C And step to the next symbol in the table
        I=I+1
        IF (I.LE.NSYMS) THEN
            IF (STYPE(I).EQ.13) GOTO 200
        END IF
 700    IF (ICTWCB) THEN
            IF (EXISTS(6)) CALL OUTSD(6)
            IF (EXISTS(7)) CALL OUTSD(7)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T S P D   -   Output special declaration (stmt fns/entrys)
C
 
        SUBROUTINE OUTSPD(TYPE)
        INTEGER TYPE
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSPEC/SPECP
        LOGICAL SPECP(132)
 
        SAVE /DSSPEC/
 
        INTEGER SPTR,NTYPE
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,YSTMT
 
        SPTR=ZYDOWN(PUROOT)
 100    NTYPE=ZYNTYP(SPTR)
        IF (NTYPE.EQ.TYPE) CALL YSTMT(SPTR,TKDESC)
        IF (SPECP(NTYPE)) THEN
            SPTR=ZYNEXT(SPTR)
            IF (SPTR.NE.0) GOTO 100
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T S P C   -   Output special section (data)
C
 
        SUBROUTINE OUTSPC(TYPE)
        INTEGER TYPE
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
 
        INTEGER SPTR
 
        INTEGER ZYDOWN,ZYNEXT,ZYNTYP
        EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,YSTMT
 
        SPTR=ZYDOWN(PUROOT)
 100    IF (ZYNTYP(SPTR).EQ.TYPE) CALL YSTMT(SPTR,TKDESC)
        SPTR=ZYNEXT(SPTR)
        IF (SPTR.NE.0) GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       O U T U N D   -   Output (previously) untyped names
C
 
        SUBROUTINE OUTUND
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSYMS/NSYMS,SYMIDX,STYPE,SDTYPE,SCHLEN,SBITS
        INTEGER NSYMS,SYMIDX(5003),STYPE(5003),
     +          SDTYPE(5003),SCHLEN(5003),
     +          SBITS(5003)
 
        SAVE /DSSYMS/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSIO/IODCMT,TKDESC
        INTEGER IODCMT,TKDESC
 
        SAVE /DSIO/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        SAVE DUMMY
 
        INTEGER I,LTYPE,DUMMY(2),LCHLEN,TEXT(134),SYMBOL(8)
 
        INTEGER LENGTH,ZYNTYP,ZIAND
        EXTERNAL ZTOKWR,LENGTH,ZYNTYP,ZYGTSY,ZYGTST,YDTYPE,YCHLEN,ZIAND
 
        DATA DUMMY(1)/129/
 
        LTYPE=0
        LCHLEN=0
        I=0
 
 100    I=I+1
        IF (I.LE.NSYMS .AND. (STYPE(I).EQ.12 .OR. SDTYPE(I).LE.0
     +      .OR. ZIAND(SBITS(I),8).NE.0)) GOTO 100
 
        IF (I.GT.NSYMS) THEN
            CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
            RETURN
        END IF
 
        IF (LTYPE.NE.SDTYPE(I)) THEN
            IF (LTYPE.NE.0) CALL ZTOKWR(TZEOS,0,DUMMY,TKDESC)
            CALL YDTYPE(SDTYPE(I),SCHLEN(I),TKDESC)
            LTYPE=SDTYPE(I)
            LCHLEN=SCHLEN(I)
        ELSE
            CALL ZTOKWR(TCOMMA,0,DUMMY,TKDESC)
        END IF
        CALL ZYGTSY(SYMIDX(I),SYMBOL)
        CALL ZYGTST(SYMBOL(2),TEXT)
        CALL ZTOKWR(TNAME,LENGTH(TEXT),TEXT,TKDESC)
        IF (SCHLEN(I).NE.LCHLEN) CALL YCHLEN(SCHLEN(I),TKDESC)
        GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       D S W A R N   -   Issue a warning from DS
C
 
        SUBROUTINE DSWARN(STRING)
        CHARACTER*(*) STRING
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
 
        EXTERNAL ZCHOUT,PUTCH
 
        CALL ZCHOUT('Warning: ',2)
        CALL ZCHOUT(STRING,2)
        IF (PUNUM.GT.0) THEN
            CALL DSNAME
        ELSE
            CALL PUTCH(10,2)
        END IF
        NWARN=NWARN+1
 
        END
C ----------------------------------------------------------------------
C
C       D S N A M E   -   Output the current program-unit name to stderr
C
 
        SUBROUTINE DSNAME
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
 
        INTEGER NAME(134),SYMBOL(8)
 
        INTEGER ZYGPUS
        EXTERNAL ZCHOUT,ZYGTSY,ZYGTST,PUTLIN,PUTCH,ZPTINT,ZYGPUS
 
        IF (STMTNO.NE.0) THEN
            CALL ZCHOUT(' at statement ',2)
            CALL ZPTINT(STMTNO,1,2)
        END IF
        CALL ZCHOUT(' in ',2)
        CALL ZYGTSY(ZYGPUS(PUNUM),SYMBOL)
        CALL ZYGTST(SYMBOL(2),NAME)
        CALL PUTLIN(NAME,2)
        CALL PUTCH(10,2)
 
        END
C ----------------------------------------------------------------------
C
C       D S E R R   -   Issue an error message from DS
C
 
        SUBROUTINE DSERR(STRING)
        CHARACTER*(*) STRING
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSSTAT/SECNUM,PUNUM,PUROOT,DUMPED,NWARN,NERROR,SNUM,
     +                STMTNO
        INTEGER SECNUM,PUNUM,PUROOT,NWARN,NERROR,SNUM,STMTNO
        LOGICAL DUMPED(22)
 
        SAVE /DSSTAT/
 
        EXTERNAL ZCHOUT,PUTCH
 
        CALL ZCHOUT('Error: ',2)
        CALL ZCHOUT(STRING,2)
        IF (PUNUM.GT.0) THEN
            CALL DSNAME
        ELSE
            CALL PUTCH(10,2)
        END IF
        NERROR=NERROR+1
 
        END
C ----------------------------------------------------------------------
C
C       D S B D   -   Block data to initialise /dstext/ SHTEXT
C
 
        BLOCK DATA DSBD
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSTEXT/ SHTEXT,OLDTXT
        INTEGER SHTEXT(43,0:22),OLDTXT(43,10:11)
 
        SAVE /DSTEXT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
        COMMON/DSOPTS/DORDER,ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,
     +                PMODE,VMODE,NOTRAI,CHLBRK,INCLPR,DTFORM
        INTEGER DORDER(-3:15),PMODE,VMODE,DTFORM
        LOGICAL ICTWCB,ARDICB,GENINT,EXEHDR,OLDFMT,CNVOLD,NOTRAI,CHLBRK,
     +          INCLPR
 
        SAVE /DSOPTS/
 
        INTEGER I
 
        DATA (SHTEXT(I,0),I=1,9)/67,32,32,32,32,32,
     +46,46,129/
        DATA (SHTEXT(I,1),I=1,23)/67,32,32,32,32,32,
     +46,46,32,80,97,114,97,109,101,116,101,114,
     +115,
     +32,46,46,129/
        DATA (SHTEXT(I,2),I=1,29)/67,32,32,32,32,32,
     +46,46,32,83,99,97,108,97,114,32,65,114,
     +103,117,109,101,110,116,115,32,46,46,129/
        DATA (SHTEXT(I,3),I=1,28)/67,32,32,32,32,32,
     +46,46,32,65,114,114,97,121,32,65,114,
     +103,117,109,101,110,116,115,32,46,46,129/
        DATA (SHTEXT(I,4),I=1,31)/67,32,32,32,32,32,
     +46,46,32,70,117,110,99,116,105,111,110,
     +32,65,114,103,117,109,101,110,116,115,
     +32,46,46,129/
        DATA (SHTEXT(I,5),I=1,33)/67,32,32,32,32,32,
     +46,46,32,83,117,98,114,111,117,116,105,110,
     +101,32,65,114,103,117,109,101,110,116,115,
     +32,46,46,129/
        DATA (SHTEXT(I,6),I=1,30)/67,32,32,32,32,32,
     +46,46,32,83,99,97,108,97,114,115,32,
     +105,110,32,67,111,109,109,111,110,
     +32,46,46,129/
        DATA (SHTEXT(I,7),I=1,29)/67,32,32,32,32,32,
     +46,46,32,65,114,114,97,121,115,32,
     +105,110,32,67,111,109,109,111,110,
     +32,46,46,129/
        DATA (SHTEXT(I,8),I=1,26)/67,32,32,32,32,32,
     +46,46,32,76,111,99,97,108,32,83,99,
     +97,108,97,114,115,
     +32,46,46,129/
        DATA (SHTEXT(I,9),I=1,25)/67,32,32,32,32,32,
     +46,46,32,76,111,99,97,108,32,65,114,114,
     +97,121,115,
     +32,46,46,129/
        DATA (SHTEXT(I,10),I=1,31)/67,32,32,32,32,32,
     +46,46,32,69,120,116,101,114,110,97,108,32,
     +70,117,110,99,116,105,111,110,115,
     +32,46,46,129/
        DATA (SHTEXT(I,11),I=1,33)/67,32,32,32,32,32,
     +46,46,32,69,120,116,101,114,110,97,108,32,
     +83,117,98,114,111,117,116,105,110,101,115,
     +32,46,46,129/
        DATA (SHTEXT(I,12),I=1,32)/67,32,32,32,32,32,
     +46,46,32,73,110,116,114,105,110,115,105,99,
     +32,70,117,110,99,116,105,111,110,115,
     +32,46,46,129/
        DATA (SHTEXT(I,13),I=1,26)/67,32,32,32,32,32,
     +46,46,32,67,111,109,109,111,110,32,98,108,
     +111,99,107,115,
     +32,46,46,129/
        DATA (SHTEXT(I,14),I=1,32)/67,32,32,32,32,32,
     +46,46,32,83,116,97,116,101,109,101,110,116,
     +32,70,117,110,99,116,105,111,110,115,
     +32,46,46,129/
        DATA (SHTEXT(I,15),I=1,25)/67,32,32,32,32,32,
     +46,46,32,69,110,116,114,121,32,80,111,105,
     +110,116,115,
     +32,46,46,129/
        DATA (SHTEXT(I,16),I=1,25)/67,32,32,32,32,32,
     +46,46,32,69,113,117,105,118,97,108,101,110,
     +99,101,115,
     +32,46,46,129/
        DATA (SHTEXT(I,17),I=1,27)/67,32,32,32,32,32,
     +46,46,32,83,97,118,101,32,115,116,97,116,
     +101,109,101,110,116,
     +32,46,46,129/
        DATA (SHTEXT(I,18),I=1,43)/67,32,32,32,32,32,
     +46,46,32,83,116,97,116,101,109,101,110,116,
     +32,70,117,110,99,116,105,111,110,32,100,101,
     +102,105,110,105,116,105,111,110,115,
     +32,46,46,129/
        DATA (SHTEXT(I,19),I=1,34)/67,32,32,32,32,32,
     +46,46,32,69,120,101,99,117,116,97,98,108,
     +101,32,83,116,97,116,101,109,101,110,116,115,
     +32,46,46,129/
C The following is currently unused but is here in case we ever want it
C (and so we don't forget about it and reuse section number 20 !!)
        DATA (SHTEXT(I,20),I=1,19)/67,32,32,32,32,32,
     +46,46,32,76,97,98,101,108,115,
     +32,46,46,129/
        DATA (SHTEXT(I,21),I=1,37)/67,32,32,32,32,32,
     +46,46,32,80,114,101,118,105,111,117,115,108,
     +121,32,117,110,116,121,112,101,100,32,110,97,109,
     +101,115,32,46,46,129/
        DATA (SHTEXT(I,22),I=1,28)/67,32,32,32,32,32,
     +46,46,32,68,97,116,97,32,115,116,97,116,
     +101,109,101,110,116,115,
     +32,46,46,129/
 
        DATA (OLDTXT(I,10),I=1,32)/67,32,32,32,32,32,
     +46,46,32,70,117,110,99,116,105,111,110,32,
     +82,101,102,101,114,101,110,99,101,115,
     +32,46,46,129/
        DATA (OLDTXT(I,11),I=1,34)/67,32,32,32,32,32,
     +46,46,32,83,117,98,114,111,117,116,105,110,
     +101,32,114,101,102,101,114,101,110,99,101,115,
     +32,46,46,129/
 
C Default order: Double Precision, Complex, Real, Integer, Logical,
C                Character
 
        DATA DORDER/0,0,0,0,5,4,6,3,2,7,0,1,0,0,0,0,0,0,0/,
     +       GENINT,ICTWCB,ARDICB,EXEHDR,OLDFMT,CNVOLD/6*.FALSE./,
     +       PMODE/2/,VMODE/2/,
     +       NOTRAI,CHLBRK,INCLPR/3*.FALSE./,DTFORM/0/
 
        END
